(*
This file is part of the Lustre reader

* Copyright (c) 2010, Nicola Camuffo.
* All rights reserved.
*
* Redistribution and use in source and binary forms, with or without
* modification, are permitted provided that the following conditions are met:
*     * Redistributions of source code must retain the above copyright
*       notice, this list of conditions and the following disclaimer.
*     * Redistributions in binary form must reproduce the above copyright
*       notice, this list of conditions and the following disclaimer in the
*       documentation and/or other materials provided with the distribution.
*     * Neither the name of Nicola Camuffo, nor the
*       names of its contributors may be used to endorse or promote products
*       derived from this software without specific prior written permission.
*
* THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDER ''AS IS'' AND ANY
* EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
* WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
* DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER BE LIABLE FOR ANY
* DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
* (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
* LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
* ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
* (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
* SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
*)


open Lustypes
open Exceptions


(* simple counter with 'next' method that increments the internal value *)
class counter =
object
  val mutable value = 0

  method value = value

  method set n = value <- n

  method next =
    value <- value + 1;
    value
end



(* simple stack that permit to get nth element *)
class ['a] stack =
object (self)
  val mutable lst = []
(*  val mutable pos = 0*)

  method push (x:'a) = 
    lst <- x::lst;
      (*self#up ()*)

  method pop () =
    try
      lst <- List.tl lst;
      (*self#up ()*)
    with (Failure "tl") -> raise (Utils_exception "pop: stack empty")

  method top () =
    try
      List.hd lst
    with (Failure "hd") -> raise (Utils_exception "top: stack empty")

(*
  method scan_down () =
    try
      let x = List.nth lst pos in
      pos <- pos-1;
      x
    with (Failure "nth") -> raise (Utils_exception "stack too little (scan_down)")

  method up () =
    pos <- List.length lst
*)

  method get n =
    try
      List.nth lst n
    with (Failure "nth") -> raise (Utils_exception "get: stack out of bound")
end


(* like 'List.map2' but with 3 lists in input *)
let map3 f l1 l2 l3 =
  let rec aux acc l1 l2 l3 = match l1,l2,l3 with
    [],[],[] -> acc
    | x::xs,y::ys,z::zs -> (f x y z)::(aux acc xs ys zs)
    | _,_,_ -> raise (Utils_exception "map3: different lengths")
  in
  aux [] l1 l2 l3

(* like 'List.iter2' but with 3 lists in input *)
let iter3 f l1 l2 l3 =
  let rec aux l1 l2 l3 = match l1,l2,l3 with
    [],[],[] -> ()
    | [x],[y],[z] -> f x y z
    | x::xs,y::ys,z::zs -> (f x y z); (aux xs ys zs)
    | _,_,_ -> raise (Utils_exception "iter3: different lengths")
  in
  aux l1 l2 l3

(* like 'List.split' but split the list in 3 parts *)
let split3 l =
  let rec aux acc1 acc2 acc3 l = match l with
    [] -> acc1,acc2,acc3
    | (x,y,z)::xs -> aux (acc1@[x]) (acc2@[y]) (acc3@[z]) xs
  in
  aux [] [] [] l

(* see 'split3' *)
let split4 l =
  let rec aux acc1 acc2 acc3 acc4 l = match l with
    [] -> acc1,acc2,acc3,acc4
    | (x,y,z,w)::xs -> aux (acc1@[x]) (acc2@[y]) (acc3@[z]) (acc4@[w]) xs
  in
  aux [] [] [] [] l

(* like 'List.combine' but with 3 lists in input *)
let combine3 l1 l2 l3 = map3 (fun x1 x2 x3 -> (x1,x2,x3)) l1 l2 l3


(* returns a slice of list, from n1 to n2 index, with step s *)
let slice_step l n1 n2 s =
  let rec aux acc l cont j = match l with
    [] -> acc
    | x::xs ->
      if cont >= n1 & cont <= n2 then
	if j = s then
	  aux (acc@[x]) xs (cont+1) 1
	else
	  aux acc xs (cont+1) (j+1)
      else
	aux acc xs (cont+1) s
  in 
  aux [] l 0 s

(* 'slice_step' with unary step *)
let slice l n1 n2 = slice_step l n1 n2 1


(* returns the list obtained removing the second one from the first one *)
let difference lst1 lst2 =
  if (List.length lst2) > (List.length lst1) then
    lst1
  else
    let rec loop l1 l2 acc = match l1 with
      [] -> acc
      | x::xs ->
	if (List.mem x l2) then
	  loop xs l2 acc
	else
	  loop xs l2 (acc@[x])
    in
    loop lst1 lst2 []


(* returns position of the first element that verifies the predicate *)
let position p l =
  let rec loop l n = match l with
    [] -> raise (Utils_exception "position: out of bound")
    | x::xs ->
      if p x then
	n
      else
	loop xs (n+1)
  in
  loop l 0


(* creates a list of elements given length and element *)
let init_list x n =
  let a = Array.create n x in
  Array.to_list a
	
	
(* if data is not stored, raises exception with message *)
let safe_find ht k s = 
  try
    Hashtbl.find ht k
  with Not_found -> 
    raise (Data_not_found_exception s)

(* save unique value; raises exception with message if data is already stored *)
let safe_set ht k v s =
  if (Hashtbl.mem ht k) then
    raise (Data_already_exists_exception s)
  else
    Hashtbl.replace ht k v

(* save value in list; raises exception with message if data is already in list *)
let safe_set_in_list ht k v s =
  let l =
    try
      safe_find ht k ""
    with Data_not_found_exception _ -> []
  in
  if (List.mem v l) then
    raise (Data_already_exists_exception s)
  else
    Hashtbl.replace ht k (l@[v])
	